package Flap::DBI;
use Flap qw/-b DBI -s -w/;
use constant dbh_pool => 'Flap::DBI::dbh_pool';

sub dbh {
    my($self, $proj, $dbn) = (shift, shift, shift);
    ($proj->_global_->{dbh_pool}{$dbn} ||= $self->dbh_pool->new($proj, $dbn))->dbh(@_);
}

package Flap::DBI::dbh_pool;

sub DESTROY { $_ && $_->disconnect for @{shift->{DBHS}} }

sub connect {
    my($self, $i) = @_;
    my $proj = $self->{project};
    my $cfg = $proj->config->DB->AUTOLOAD($self->{DBN})->dsn->[$i];
    my $dbh = DBI->connect(@{$cfg}[0 .. 2], {
        %{$cfg->[3] || {}},
        RaiseError => 0,
        RootClass => $proj->DBI,
        private_flap_dbh => [$self => $i],
    }) || do{
        die $DBI::errstr if !$i;
        warn "Trying master dbh because slave($self->{DBN}:$i) connection failed: $DBI::errstr";
        $self->{DBHS}[0]->clone;
    };
    
    $dbh->STORE('RaiseError' => 1);
    if(my $org = $self->{DBHS}[$i]){
        warn "DBH reconnected ($self->{DBN}:$i)";
        $org->swap_inner_handle($dbh);
        return $org;
    }
    $proj->_weaken_($dbh->{private_flap_dbh}[0]);
    $self->{DBHS}[$i] = $dbh;
}

sub dbh {
    my $self = shift;
    $self->{DBHS}[@_ ? shift : ($self->{idx} = ($self->{idx} + 1) % @{$self->{DBHS}})];
}

sub finalize {
    my $self = shift;
    $self->flush_txn_log if $self->{txn_log};
    $self->{auto_reconnect} = $self->{txn_log} = $self->{use_master} = 0;
    $self;
}

sub flush_txn_log {
    my $self = shift;
    my $proj = $self->{project};
    my $txn_log = $self->{txn_log} || return !(warn 'No txn_log');
    my $buf = '';
    my(@buf, $unc);
    foreach(@{$txn_log->{buf} || die}){
        if(@{$_->[2]}){ #committed
            $_->[1] =~ s/\s+/ /g;
            $_->[1] =~ s/^ //;
            $_->[1] =~ s/ \z//;
            $buf .= $_->[1]."\n";
            $buf .= ' - '.$proj->Util->ary2tsv(@$_)."\n" for @{$_->[2]};
            undef @{$_->[2]};
        }
        push(@buf, $_) if $_->[0]; #sth alive
        $unc++ if @{$_->[3]}; #uncommitted
    }
    warn "Found $unc uncommitted txn" if $unc;
    $txn_log->{buf} = \@buf;
    return !1 if !$buf;
    my $log = $proj->log($txn_log->{log} || 'txn');
    $log->print($log->now->hms."\t$txn_log->{head}\n$buf\n");
}

sub new {
    my($class, $proj, $dbn) = @_;
    my $self = bless {
        project        => $proj,
        DBN            => $dbn,
        DBHS           => [],
        idx            => -1,
        auto_reconnect => 0,
        txn_log        => 0,
        use_master     => 0,
    }, $class;
    $self->connect($_) for(0 .. $#{$proj->config->DB->$dbn->dsn});
    $self;
}

package Flap::DBI::db;
@Flap::DBI::db::ISA = qw/DBI::db/;

sub auto_reconnect {
    my $dbh = shift;
    die 'No arguments' if !@_;
    $dbh->{private_flap_dbh}[0]{auto_reconnect} = $_[0] ? 1 : 0;
    $dbh;
}

sub auto_reconnect_do {
    my($dbh, $cb, $rescue) = (shift, shift, shift);
    my $pfd = $dbh->{private_flap_dbh}; # [dbh_pool => dbh_id]
    my($wa, $warn, $die, @r, $r) = (wantarray, '');
    eval{
        local $::SIG{__WARN__} = sub{ $warn .= $_[0] };
        $wa ? (@r = $cb->(@_)) : ($r = $cb->(@_))
    };
    if(($die = $@) && !$dbh->ping){
        $pfd->[0]->connect($pfd->[1]);
        $rescue->() if $rescue;
        return $cb->(@_);
    }
    warn $warn if $warn;
    die $die if $die;
    $wa ? @r : $r;
}

sub debug {
    my($dbh, $method, $sql, @bind) = (shift, shift, shift || '', @{shift || []});
    $sql =~ s/\?/$dbh->quote(shift(@bind))/eg if @bind;
    $sql =~ s/^\s+//;
    $sql =~ s/\s+\z//;
    $sql = qq{"$sql"} if $sql;
    my $pfd = $dbh->{private_flap_dbh}; # [dbh_pool => dbh_id]
    my $proj = $pfd->[0]{project};
    my $ln = $proj->Util->debug_line;
    $proj->tracer('__WARN__', {
        %{$proj->trace_option || {}},
        warn => sub{
            my $st = '';
            if($::ENV{FLAP_DEBUG} > 1){
                ($st = shift) =~ s/^ at __WARN__.+\n//;
                $st =~ s%^ at .+\(Flap/(DBI|Schema).+ \d+\)\n%%mg if $::ENV{FLAP_DEBUG} == 2;
            }
            print STDERR qq{$ln\$($pfd->[0]{DBN}:$pfd->[1])->$method($sql)\n$st$ln};
        },
    })->('');
}

sub flush_txn_log { shift->{private_flap_dbh}[0]->flush_txn_log }

sub master {
    my $dbh = shift;
    my $pfd = $dbh->{private_flap_dbh}; # [dbh_pool => dbh_id]
    ($pfd->[1] ? $pfd->[0]{DBHS}[0] : $dbh);
}

sub no_txn_do {
    my($dbh, $cb) = (shift, shift);
    local $dbh->{private_flap_dbh}[2] = 1;
    $cb->(@_);
}

sub txn_do {
    my($dbh, $cb) = (shift, shift);
    return $cb->(@_) if $dbh->{private_flap_dbh}[0]{DBHS}[0]->FETCH('BegunWork');
    $dbh->begin_work;
    my $r = eval{ $cb->(@_) };
    return $dbh->commit && $r if !(my $msg = $@);
    $dbh->rollback;
    die $msg;
}

sub txn_log {
    my $dbh = shift;
    die 'No arguments' if !@_;
    my $pool = $dbh->{private_flap_dbh}[0];
    $pool->flush_txn_log if $pool->{txn_log};
    $pool->{txn_log} = $_[0] ? {buf => [], head => shift, log => shift} : 0;
    $dbh;
}

sub use_master {
    my $dbh = shift;
    $dbh->{private_flap_dbh}[0]{use_master} = 1;
    $dbh;
}

sub _define_method {
    my($self, $method, $cb, $is_txn, $prepare) = @_;
    my $code = sub{
        my $dbh = shift;
        my $pfd = $dbh->{private_flap_dbh}; # [dbh_pool => dbh_id]
        return $pfd->[0]{DBHS}[0]->$method(@_) if $pfd->[1] && !$pfd->[2] && (
            $pfd->[0]{use_master} || (
                $is_txn
             || $_[0] !~ /^\s*select/i #not select
             || !$pfd->[0]{DBHS}[0]{AutoCommit} && $_[0] =~ /\sfor\s+update\b/i #for update
            ) && $dbh->use_master
        );
        
        return $cb->($dbh, $pfd, @_) if $prepare || !$pfd->[0]{auto_reconnect};
        
        $pfd->[0]{auto_reconnect} = 0; #try once
        $dbh->auto_reconnect_do(sub{ $cb->($dbh, $pfd, @_) }, undef, @_);
    };
    no strict 'refs';
    *$method = $code;
}

__PACKAGE__->_define_method('begin_work', sub{
    my($dbh, $pfd) = (shift, shift);
    $dbh->debug('begin_work') if $::ENV{FLAP_DEBUG};
    $dbh->SUPER::begin_work(@_);
}, 1);

__PACKAGE__->_define_method('commit', sub{
    my($dbh, $pfd) = (shift, shift);
    $dbh->debug('commit') if $::ENV{FLAP_DEBUG};
    my $rc = $dbh->SUPER::commit(@_);
    if($pfd->[0]{txn_log}){
        push @{$_->[2]}, splice(@{$_->[3]}, 0) for @{$pfd->[0]{txn_log}{buf}};
    }
    $rc;
}, 1);

__PACKAGE__->_define_method('do', sub{
    my($dbh, $pfd) = (shift, shift);
    $dbh->debug('do', $_[0], $#_ >= 2 ? [@_[2 .. $#_]] : ()) if $::ENV{FLAP_DEBUG};
    my $rv = $dbh->SUPER::do(@_);
    if(my $txn_log = $pfd->[0]{txn_log}){
        push @{$txn_log->{buf}}, my $log = [undef, $_[0], [], []];
        push @{$log->[$dbh->{AutoCommit} ? 2 : 3]}, ($_[2] || []);
    }
    $rv;
}, 1);

foreach(qw/prepare prepare_cached/){
    my $super = "SUPER::$_";
    __PACKAGE__->_define_method($_, sub{
        my($dbh, $pfd) = (shift, shift);
        my $sth = $dbh->$super(@_);
        my $pfs = $sth->{private_flap_sth} = [$pfd->[0]{auto_reconnect}];
        if((my $txn_log = $pfd->[0]{txn_log}) && $_[0] !~ /^\s*select/){
            push @{$txn_log->{buf}}, my $log = $pfs->[1] = [$sth, $_[0], [], []];
            $pfd->[0]{project}->_weaken_($log->[0]);
        }
        $sth;
    }, undef, 1);
}

__PACKAGE__->_define_method('rollback', sub{
    my($dbh, $pfd) = (shift, shift);
    $dbh->debug('rollback') if $::ENV{FLAP_DEBUG};
    my $rc = $dbh->SUPER::rollback(@_);
    if($pfd->[0]{txn_log}){
        splice(@{$_->[3]}, 0) for @{$pfd->[0]{txn_log}{buf}};
    }
    $rc;
}, 1);

__PACKAGE__->_define_method('selectall_arrayref', sub{
    my($dbh, $pfd) = (shift, shift);
    $dbh->debug('selectall_arrayref', $_[0]) if $::ENV{FLAP_DEBUG};
    $dbh->SUPER::selectall_arrayref(@_);
});

__PACKAGE__->_define_method('selectall_hashref', sub{
    my($dbh, $pfd) = (shift, shift);
    $dbh->SUPER::selectall_hashref(@_);
});

__PACKAGE__->_define_method('selectcol_arrayref', sub{
    my($dbh, $pfd) = (shift, shift);
    $dbh->SUPER::selectcol_arrayref(@_);
});

__PACKAGE__->_define_method('selectrow_array', sub{
    my($dbh, $pfd) = (shift, shift);
    $dbh->debug('selectrow_array', $_[0]) if $::ENV{FLAP_DEBUG};
    $dbh->SUPER::selectrow_array(@_);
});

__PACKAGE__->_define_method('selectrow_arrayref', sub{
    my($dbh, $pfd) = (shift, shift);
    $dbh->debug('selectrow_arrayref', $_[0]) if $::ENV{FLAP_DEBUG};
    $dbh->SUPER::selectrow_arrayref(@_);
});

__PACKAGE__->_define_method('selectrow_hashref', sub{
    my($dbh, $pfd) = (shift, shift);
    $dbh->SUPER::selectrow_hashref(@_);
});

package Flap::DBI::st;
@Flap::DBI::st::ISA = qw/DBI::st/;

sub execute {
    my $sth = shift;
    $sth->{Database}->debug('execute', $sth->{Statement}, \@_) if $::ENV{FLAP_DEBUG};
    my $pfs = $sth->{private_flap_sth}; # [auto_reconnect => txn_log_buf]
    my $rv = !$pfs->[0] ? $sth->SUPER::execute(@_) : do{
        my $dbh = $sth->{Database};
        $pfs->[0] = $dbh->{private_flap_dbh}[0]{auto_reconnect} = 0; #try once
        $dbh->auto_reconnect_do(
            sub{ $sth->SUPER::execute(@_) },
            sub{ $sth->swap_inner_handle($dbh->prepare($sth->{Statement}), 1) },
            @_,
        );
    };
    if(my $log = $pfs->[1]){
        push @{$log->[$sth->{Database}{AutoCommit} ? 2 : 3]}, [@_];
    }
    $rv;
}

1;
